#'* Use eye-friendly comment syntax *
options(scipen=6) #'* Display digits, not the scientific version *
options(digits.secs=6) #'* Use milliseconds in Date/Time data types *
options(warning=FALSE) #'* Don't show warnings *
par(mfrow=c(1,1)) #'* Reset plot placement to normal 1 by 1 *
# ------------------------------------------------------------------------------
# packages:
require(sp)
require(sf)
require(tidyverse)
require(sqldf)
require(readr)
require(dplyr)
require(moveVis)
require(move)
require(lubridate)
require(ggmap)
require(ggplot)
require(leaflet)
require(dplyr)
require(purrr)
require(knitr)#'* Load Data *
wildboar <- read_delim("C:/Users/olive/OneDrive/Desktop/boar/wildschwein_BE_all_raw.csv", delim=",")
#'* Extract month for facet wrap *
wildboar$month <- month(ymd(wildboar$DatumUTC))
wildboar$month <- month.name[wildboar$month] # convert month numbers to names
wildboar$day2 <- day(ymd(wildboar$DatumUTC))
wildboar$dayname<-format(wildboar$DatumUTC, format="%m-%d")
#'* Investigate covered distance during the day categories *
wildboar <- wildboar[wildboar$distance<5000,]
wildboar <- wildboar[wildboar$day != "Nacht",]
wildboar <- wildboar[!(is.na(wildboar$day)),]
#'* Resample wildboar names *
wildboar$Name <- substring(wildboar$Tier,5,8) #the substring function works due to the fact that all boar names have only 4 letters.#'* We create an SF object to cast points to linestring *
wildboar_sf = st_as_sf(wildboar, coords=c("Long","Lat"))
wildboar_sf <- wildboar_sf %>%
dplyr::group_by(Name, month) %>%
dplyr::summarise() %>%
st_cast("LINESTRING")
#'* The SF object is splited to a list by month *
wildboar.df <- split(wildboar_sf, wildboar_sf$month)
#'* Generate color palette for leaflet *
factpal <- colorFactor(topo.colors(20), wildboar$Name)
#'* Leaflet map with baseGroups to get an overview *
boarMap <- leaflet() %>% addTiles()
names(wildboar.df) %>%
purrr::walk( function(df) {
boarMap <<- boarMap %>%
addPolylines(data = wildboar.df[[df]],
label=~as.character(Name),
popup=~as.character(Name),
group = df,
color = ~factpal(Name),
fillOpacity = 1,
smoothFactor = 0.2
)
})
boarMap %>%
addLayersControl(
baseGroups = names(wildboar.df),
options = layersControlOptions(collapsed = FALSE)
)#'* Investigate mean speed *
wildboarDays <- wildboar %>%
group_by(Name, DatumUTC)%>%
summarise(
mean_speed = mean(speed,na.rm=T)
)
#'* Overview of the different timespans for each boar *
#'* Question: There are different records included. Can we merge them? *
ggplot(wildboarDays, aes(x=DatumUTC, y=Name)) +
geom_point() +
theme_classic()#'* Investigate available months by boar *
#'* Only Miri, Sabi and Caro have records for each month *
#'* Perhaps we have to define a threshold for minimum months *
wildboarmonth <- wildboar %>%
group_by(Name) %>%
summarise(n_distinct(month))
kable(wildboarmonth, caption = "Overview of the boars and the available months")| Name | n_distinct(month) |
|---|---|
| Amos | 10 |
| Caro | 12 |
| Clau | 2 |
| Dona | 5 |
| Evel | 4 |
| Fran | 5 |
| Frid | 6 |
| Frit | 3 |
| Gab2 | 3 |
| Gaby | 1 |
| Isab | 5 |
| Joha | 6 |
| Miri | 12 |
| Nico | 5 |
| Olga | 7 |
| Rosa | 8 |
| Ruth | 9 |
| Sabi | 12 |
| Ueli | 9 |
| Venu | 7 |
#'* Extract month for facet wrap *
wildboar$month <- month(ymd(wildboar$DatumUTC))
wildboar$day2 <- day(ymd(wildboar$DatumUTC))
wildboar$dayname<-format(wildboar$DatumUTC, format="%m-%d")
#'* With density maps the seasonal patterns can be detected. *
#'* Define boundingbox (region Neuenburg/Murten and load an OSM basemap*
sbbox <- make_bbox(lon = c(6.973915, 7.129238), lat = c(46.96355, 47.025072), f = .1)
wildRegion <- get_map(location = sbbox, color = "bw", source = "osm")
wildRegion <- ggmap(wildRegion)
#'* create density maps for each month*
wildRegion + stat_density2d(aes(x = Long, y = Lat, fill = ..level..), alpha = 0.25, bins = 50, data = wildboar, geom = "polygon") +
scale_fill_gradient(low = "black", high = "red") +
facet_wrap(~ month) +
theme_bw() +
theme(legend.position="none")#'* create density maps for day category*
wildRegion + stat_density2d(aes(x = Long, y = Lat, fill = ..level..), alpha = 0.25, bins = 50, data = wildboar, geom = "polygon") +
scale_fill_gradient(low = "black", high = "red") +
facet_wrap(~ day) +
theme_bw() +
theme(legend.position="none")#'* Investigate covered distance during the day categories *
wildboarDistance <- wildboar %>%
group_by(day) %>%
summarise(
mean_distance = mean(distance,na.rm=T),
sum_distance = sum(distance,na.rm=T),
median_distance = median(distance,na.rm=T)
)
kable(wildboarDistance, caption = "Day stages with mean, sum and median covered distance")| day | mean_distance | sum_distance | median_distance |
|---|---|---|---|
| 1Nachtviertel | 77.48824 | 2760983.5 | 26.076810 |
| 2Nachtviertel | 66.74790 | 2369617.3 | 19.646883 |
| 3Nachtviertel | 52.06993 | 1854522.5 | 10.295630 |
| 4Nachtviertel | 27.38143 | 917962.6 | 4.472136 |
| Abenddaemmerung | 86.24582 | 700747.3 | 31.064449 |
| Morgendaemmerung | 15.52597 | 118928.9 | 4.123106 |
| Tag | 22.50553 | 3750253.8 | 5.000000 |
#'* Investigate covered distance during the day categories *
wildDay <- wildboar %>%
group_by(month, day2, day) %>%
summarise(
mean_distance = mean(distance,na.rm=T),
sum_distance = sum(distance,na.rm=T),
median_distance = median(distance,na.rm=T)
)
ggplot(wildDay, aes(x = day2, y = mean_distance)) +
geom_line(aes(color = day, linetype = day)) +
scale_color_manual(values = c("dodgerblue", "cornflowerblue", "darkorchid", "mediumorchid" , "turquoise", "darkorange", "goldenrod")) +
facet_wrap(~ month) +
theme_bw() +
labs(title="Mean walking distance of all tracked wildboars for each month",
x ="Days [d]", y = "Mean walking distance [m]")#'* Generates a GIF of the spatial and temporal distribution. Markdown isn't able to process: Resolving timed out *
#
# wildboar_move <- wildboar
# wildboar_move <- df2move(wildboar_move,
# proj = "+init=epsg:4326 +proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0",
# x = "Long", y = "Lat", time = "ZeitpUTC", track_id = "Tier")
#
#
# # align move_data to a uniform time scale
# m <- align_move(wildboar_move, res = 1440, unit = "mins")
#
# # create spatial frames with a OpenStreetMap watercolour map
# frames <- frames_spatial(m, path_colours = c("red", "green", "blue","goldenrod","darkolivegreen1","indianred","indianred2","gray95","khaki","ivory","orange","beige","navy","hotpink3","brown2","brown","gainsboro","azure","aquamarine","cyan","firebrick","darkcyan","darkkhaki"),
# map_service = "osm", map_type = "watercolor", alpha = 0.5) %>%
# add_labels(x = "Longitude", y = "Latitude") %>% # add some customizations, such as axis labels
# add_northarrow() %>%
# add_scalebar() %>%
# add_timestamps(m, type = "label") %>%
# add_progress()
#
# # animate frames
# animate_frames(frames, out_file = "moveVis.gif")